!// Dmitry.Konovalov@jcu.edu.au Dmitry.A.Konovalov@gmail.com, 2013

module dbg_mod; 
use types_mod;
implicit none;  ! one per module

logical, parameter :: DBG_CALL_FLUSH = .TRUE.;
integer, parameter :: VEC_DBG_VIEW_N = 10;

contains;

character(len=1024) function int_to_str(i)  result(res);  
  integer, intent(IN):: i; 
  write(res, *) i; 
  res = ADJUSTL(res);
end function





!--> dbg_xxx

subroutine dbg_str(info, on);    
  character(LEN=*), intent(in) :: info;   
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) RETURN; 
  write(*,*) info;
end subroutine

subroutine dbg_str2(info, str, on);   
  character(LEN=*), intent(in) :: info, str;   
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) RETURN;   
  write(*,*) info, "'", str, "'";
  if (DBG_CALL_FLUSH) call FLUSH;
end subroutine

subroutine dbg_in(str, on);    
  character(LEN=*), intent(in) ::  str;   
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) RETURN;
  call dbg_str2("-->-", TRIM(str), on);
  if (DBG_CALL_FLUSH) call FLUSH;
end subroutine

subroutine dbg_out(str, on);    
  character(LEN=*), intent(in) ::  str;   
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) RETURN;
  call dbg_str2("-<--", TRIM(str), on);
  if (DBG_CALL_FLUSH) call FLUSH;
end subroutine

subroutine dbg_bool(info, v, on);    
  character(LEN=*), intent(in) :: info;   
  logical, intent(in) :: v; 
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) RETURN;  
  write(*,*) info, v;
  if (DBG_CALL_FLUSH) call FLUSH;
end subroutine

subroutine dbg_dp(info, v, on);   
  character(LEN=*), intent(in) :: info;   
  real(DP), intent(in) :: v; 
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) RETURN;  
  write(*,*) info, v;
  if (DBG_CALL_FLUSH) call FLUSH;
end subroutine


subroutine dbg_cmplx(info, v, on);   
  character(LEN=*), intent(in) :: info;   
  complex(DP), intent(in) :: v; 
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) RETURN;  
  write(*,*) info, v;
  if (DBG_CALL_FLUSH) call FLUSH;
end subroutine


subroutine dbg_int(info, v, on);   
  character(LEN=*), intent(in) :: info;   
  integer, intent(in) :: v; 
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) RETURN;
  write(*,*) info, TRIM(int_to_str(v));
  if (DBG_CALL_FLUSH) call FLUSH;
end subroutine

!--> test_xxx
logical function dbg_max_zero(z) result(res);
  real(DP), intent(in) :: z;
  res = dbg_abs_LE(z, MAX_ZERO);
  return;
end function

logical function dbg_abs_LE(z, max_err) result(res);
  real(DP), intent(in) :: z, max_err;
  res = (ABS(z) <= ABS(max_err));
  return;
end function

logical function dbg_abs_diff_LE(z, z2, max_err, trace_on) result(res);
  real(DP), intent(in) :: z, z2, max_err;
  logical, optional, intent(in) :: trace_on;
  call dbg_dp("dbg_abs_diff_LE(z=", z, trace_on);
  call dbg_dp("  ____________(z2=", z2, trace_on);
  call dbg_dp("  _____(ABS(z-z2)=", ABS(z-z2), trace_on);
  call dbg_dp("  ________max_err=", max_err, trace_on);
  res = (ABS(z-z2) <= ABS(max_err));
  return;
end function

logical function dbg_cabs_diff_LE(z, z2, max_err, trace_on) result(res);
  complex(DP), intent(in) :: z, z2;
  real(DP), intent(in) :: max_err;
  logical, optional, intent(in) :: trace_on;
  call dbg_cmplx("dbg_cabs_diff_LE(z=", z, trace_on);
  call dbg_cmplx("_______________(z2=", z2, trace_on);
  call   dbg_dp("________(ABS(z-z2)=", ABS(z-z2), trace_on);
  call   dbg_dp("___________max_err=", max_err, trace_on);
  res = (ABS(z-z2) <= ABS(max_err));
  return;
end function

subroutine dbg_assert_abs_LE(info, z, max_err); 
  character(LEN=*), intent(in) :: info;
  real(DP), intent(in) :: z, max_err;
  if (dbg_abs_LE(z, max_err)) RETURN;
  call dbg_dp(info, z);
  call dbg_dp("exit dbg_assert_abs_LE=", max_err);
  call exit(1);
return;
end subroutine

subroutine dbg_assert_abs_diff_LE(info, z, z2, maxerr); 
  character(LEN=*), intent(in) :: info;
  real(DP), intent(in) :: z, z2, maxerr;
  logical :: ok;
  ok = dbg_abs_diff_LE(z, z2, maxerr, .FALSE.);
  if (ok) RETURN;
  
  call dbg_str(info, .TRUE.);
  ok = dbg_abs_diff_LE(z, z2, maxerr, .TRUE.); ! report error
  call exit(1);
end subroutine


subroutine dbg_assert_cabs_diff_LE(info, z, z2, maxerr); 
  character(LEN=*), intent(in) :: info;
  complex(DP), intent(in) :: z, z2;
  real(DP), intent(in) :: maxerr;
  logical :: ok;
  ok = dbg_cabs_diff_LE(z, z2, maxerr, .FALSE.);
  if (ok) RETURN;
  
  call dbg_str(info, .TRUE.);
  ok = dbg_cabs_diff_LE(z, z2, maxerr, .TRUE.); ! report error
  call exit(1);
end subroutine

subroutine dbg_assert_zero(info, z);
  character(LEN=*), intent(in) :: info;
  real(DP), intent(in) :: z;
  call dbg_assert_abs_LE(info, z, MAX_ZERO);
end subroutine

subroutine dbg_assert_not_zero(info, z);
  character(LEN=*), intent(in) :: info;
  real(DP), intent(in) :: z;
  call dbg_assert_abs_LE(info, MAX_ZERO, z);
end subroutine

logical function dbg_is_zero(x) result(res);   
  real(DP), intent(IN) :: x; 
  res = ABS(x) < MAX_ZERO;      
  return;
end function

logical function dbg_neg_int_or_zero(z) result(res);   
  complex(DP), intent(IN) :: z; 
  real(DP) :: x;
  x = real(z, DP);
  res = dbg_is_zero(AIMAG(z)) .AND. -ABS(x) .EQ. INT(x);      
  return;
end function

subroutine dbg_assert_true(info, b); ;
  character(LEN=*), intent(in) :: info;
  logical, intent(in) :: b;
  if (b) RETURN;

  call dbg_bool(info, b);
  call dbg_str("exit dbg_assert_true");
  call exit(1);
end subroutine

subroutine assert_help_str(help, str); 
  character(LEN=*), intent(in) :: help, str;
  if (help == str) RETURN;
    
  call dbg_str2("help=", help);
  call dbg_str2("str =", str);
  call dbg_str("exit in assert_help_str");
  call exit(1);
end subroutine


end module 